home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
system
/
pgraf130.zip
/
PASCAL.ZIP
/
DEMO_SCR.PAS
next >
Wrap
Pascal/Delphi Source File
|
1991-10-14
|
7KB
|
215 lines
unit demo_scr;
{*******************************************************************
* *
* 'Printer Graphics Interface' Demonstration Program *
* Screen Output Module *
* *
* Main program: DEMO.PAS *
* Author: F van der Hulst *
* *
* Revisions: *
* 27 March 1991: Initial release (Turbo C v2.0 only) *
* 07 April 1991: Ported to MicroSoft C v5.1 *
* 15 October 1991: Rewritten in Turbo-Pascal *
* *
*******************************************************************}
{$B-} { Short circuit boolean evaluation }
{$I-} { I/O checking OFF }
{$R-} { Range checking OFF }
{$S-} { Stack checking OFF }
{$V-} { Var-str check OFF }
interface
uses pgraph, crt, graph, demo_sub, various;
const MAX_WIDTH = 801;
CONST
UnitVersion = '1.00' ;
UnitVerDate = '10 Sep 91' ;
procedure image_demo;
procedure view_demo;
procedure start_screen_output;
procedure stop_screen_output;
implementation
{*******************************************************************
Draw an elliptical pie chart on the printer. }
procedure draw_elliptical_pie;
begin
p_setviewport(0, 0, 500, 120, 0);
p_outtextxy(300, 50, 'Elliptical Pie chart');
p_setlinestyle(SolidLn, 0, NormWidth);
p_setfillstyle(CLOSEDOTFILL, 1);
p_sector(150, 50, 0, 50, 75, 30);
p_setfillstyle(HATCHFILL, 1);
p_sector(150, 50, 50, 120, 75, 30);
p_setfillstyle(XHATCHFILL, 1);
p_sector(150, 50, 120, 190, 75, 30);
p_setfillstyle(WIDEDOTFILL, 1);
p_sector(150, 50, 190, 290, 75, 30);
p_setlinestyle(SOLIDLN, 0, THICKWIDTH);
p_setfillstyle(INTERLEAVEFILL, 1);
p_sector(160, 60, 290, 360, 75, 30);
end;
{*******************************************************************
Switch screen to graphics mode, and start echoing printer output to
the screen. }
procedure start_screen_output;
var driver, mode: integer;
begin
driver := DETECT;
detectgraph(driver, mode);
case driver of
VGA, EGA: begin
driver := CGA;
mode := CGAHI;
end;
CGA: begin
{ registerbgidriver(CGA_driver); }
mode := CGAHI;
end;
HERCMONO: begin
{ registerbgidriver(Herc_driver); }
mode := HERCMONOHI;
end;
ATT400: mode := ATT400HI;
PC3270: mode := PC3270HI;
MCGA: mode := MCGAHI;
end;
initgraph(driver, mode, '');
if (driver < 0) then begin
writeln('BGI Error: ', grapherrormsg(graphresult));
halt(1);
end;
__p_putpixel_screen := @putpixel;
screen_echo := true;
end;
{*******************************************************************
Switch screen back to text mode, and stop echoing printer output to
the screen. }
procedure stop_screen_output;
begin
closegraph;
__p_putpixel_screen := nil;
screen_echo := false;
end;
{*******************************************************************
Scale an image to best fit the aspect ratio of the printer. This only
works if the resulting xaspect >= yaspect }
function scale_image(var bitmap: image_type; xscale: integer): boolean;
var x, y, right, bottom, old_width: integer;
var new_width, new_x: integer;
var source, dest, pixel: integer;
begin
if xscale = 0
then scale_image := false
else begin
right := bitmap.header[0];
bottom := bitmap.header[1];
old_width := (right+7) div 8;
new_width := (old_width + xscale - 1) div xscale;
bitmap.header[0] := new_width * 8 - 1;
for y := 0 to bottom do begin
new_x := 0;
x := 0;
while x <= right do begin
source := y * old_width + x div 8;
dest := y * new_width + new_x div 8;
pixel := (bitmap.data[source] shr (7 - (x and 7))) and 1;
bitmap.data[dest] := bitmap.data[dest] and ($FF7F shr (new_x and 7));
bitmap.data[dest] := bitmap.data[dest] or (pixel shl (7 - (new_x and 7)));
x := x + xscale;
new_x := new_x + 1;
end;
end;
scale_image := true;
end;
end;
{*******************************************************************
Display Anne's face on the printer and screen, firstly unscaled (it
was saved as an image from a CGA screen via getimage), then scaled
to fit the printer's aspect ratio as near as possible. In between,
use putimage & getimage, and p_putimage & p_getimage, to swap characters
from the printer buffer to screen and vice versa. }
procedure image_demo;
var imagep, imageg: array [0..129] of char;
var sizep: integer;
var xaspp, yaspp: integer;
var depth, width, left: integer;
var dummy: char;
var ch: char;
begin
writeln; writeln;
writeln('PICTURE DRAWING DEMO'); writeln;
width := face.header[0];
depth := face.header[1];
left := (MAX_WIDTH - width) div 2;
p_setviewport(left, 0, left + width, depth, 0);
writeln('Result = ', p_graphresult, grapherrormsg(-5));
sizep := p_imagesize(50, 20, 60, 30);
writeln('Image size = ', sizep, ' bytes');
start_screen_output;
p_putimage(0, 0, face, NotPut);
end_slice;
cleardevice;
outtextxy(0,100, 'Getimage/putimage swapping screen/printer');
p_outtextxy(50, 20, 'F');
outtextxy(50, 20, 'G');
p_getimage(50, 20, 60, 30, imagep);
getimage(50, 20, 60, 30, imageg);
p_putimage(60, 20, imageg, COPYPUT);
putimage(60, 20, imagep, COPYPUT);
end_slice;
cleardevice;
p_getaspectratio(xaspp, yaspp);
if (scale_image(face, (longint(12) * xaspp) div (yaspp * longint(5)))) then begin
outtextxy(0,180, 'Printing Scaled image');
p_outtextxy(0,150, 'Scaled');
p_putimage(0, 0, face, NOTPUT);
end_slice;
end else begin
outtextxy(0, 180, 'Can''t scale image -- Press a key to continue');
dummy := readkey;
end;
stop_screen_output;
end;
{*******************************************************************
Draw a circular pie chart on the printer, then display it on the
screen. }
procedure view_demo;
begin
writeln; writeln;
writeln('IMAGE VIEWING DEMO'); writeln;
writeln('Viewing Elliptical pie chart, various fill patterns');
draw_elliptical_pie;
start_screen_output;
p_view;
outtextxy(0, 180, 'Press a key to continue');
stop_screen_output;
end;
BEGIN { unit body }
END. { unit body }